home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Toolbox classes / Menu < prev    next >
Encoding:
Text File  |  1995-09-23  |  1.7 KB  |  72 lines  |  [TEXT/MSET]
  1. \ Menu class.
  2. \ Sept 90  mrh  item# anomalies fixed
  3.  
  4. from  MENUMOD  import{  MENU  APPLEMENU  EDITMENU  }
  5.  
  6. compile: menuMod
  7. lock: menuMod
  8. true setInstall: MenuMod
  9.  
  10.  
  11. : DODSK        \ ( item# -- item# )  Executes the desk accessory for an item.
  12.             \  Note we can send a late-bound msg to self even though we're
  13.             \  not lexically in a class, since this word will only be called
  14.             \  from a method.
  15.  
  16.     dup  openDesk: [self]  ;
  17.  
  18.  
  19. : MSELECT    \ ( point -- item# menuID )   Calls menu manager to track a menu selection
  20.     0 swap  call MenuSelect  unpack swap 1- swap  ;
  21.  
  22.  
  23. :class    MBAR        super{ object }
  24.  
  25.    24    ordered-col    IDs
  26.    24    array        MENUS        \ array of menu objects
  27.  
  28. :m DRAW:    call DrawMenuBar  ;m
  29.  
  30. :m CLEAR:    call ClearMenuBar   clear: IDs  ;m
  31.  
  32. :m ADD:        \ ( men1 ... menN N -- )  Adds menu objects to the MenuBar object.
  33.  
  34.     0 DO  i to: menus  i at: menus  id: **  add: ids  LOOP  ;m
  35.  
  36. :m NEW:        \ Inserts menus in Toolbox MenuBar list.
  37.     size: IDs  0
  38.     do   size: IDs  1- i -  at: menus  insert: **   loop
  39.     draw: self  ;m
  40.  
  41. :m INIT:        \ ( men1 ... menN N -- )
  42.     clear: self  add: self  new: self  ;m
  43.  
  44. :m EXEC:    \ ( item# MenuID -- )
  45.     dup 0>
  46.     IF        indexOf: IDs  IF  at: menus  exec: **  THEN
  47.     ELSE    2drop
  48.     THEN  ;m
  49.  
  50. :m CLICK:    where: fevent  mSelect  exec: self  ;m
  51.  
  52. :m KEY:        \ ( c -- )  Handles a possible menu key selection
  53.     0 swap makeint  call MenuKey  unpack  swap 1- swap
  54.     exec: self  ;m
  55.     
  56. :m ENABLE:    \ Enables all menus in the Menu Bar
  57.     size: IDs  0
  58.     DO  i  at: menus  handle: **  word0  call EnableItem  LOOP
  59.     draw: self  ;m
  60.  
  61. :m DISABLE:
  62.     size: IDs  0
  63.     DO  i  at: menus  handle: **  word0  call DisableItem  LOOP
  64.     draw: self  ;m
  65.  
  66. ;class
  67.  
  68.  
  69. mBar    MENUBAR                \ Our default menu bar
  70.  
  71. menubar  put: MBaddr        \ Set as current menu bar
  72.